home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2004 #2 / Amiga Plus CD - 2004 - No. 02.iso / AmigaPlus / Tools / Development / AmigaTalk / intuition / GadTools.st < prev    next >
Encoding:
Text File  |  2004-01-31  |  16.5 KB  |  505 lines
  1. " --------------------------------------------------------------------- " 
  2. " GadTools class is the Parent class that interfaces AmigaTalk to the   "
  3. " gadtools.library in AmigaDOS.                                         "
  4. " --------------------------------------------------------------------- " 
  5.  
  6. Class GadTools :Glyph ! intuiMsgObj windowObj visualInfoObj !
  7. [
  8.    drawBoxFrom: sPoint to: ePoint tags: tagArray ! x y w h !
  9.       " This is a beveled box.  The tags will say whether it's recessed or not "
  10.       x <- sPoint x. " These are NOT checked against window boundaries "
  11.       y <- sPoint y.
  12.       w <- ePoint x.
  13.       h <- ePoint y.
  14.       
  15.       <primitive 239 2 windowObj x y w h tagArray>
  16. |
  17.    beginRefresh
  18.       <primitive 239 3 2 windowObj>
  19. |
  20.    endRefresh: completeFlag
  21.       <primitive 239 3 3 windowObj completeFlag> " completeFlag = true or false"
  22. |
  23.    getIMsg
  24.       ^ intuiMsgObj <- <primitive 239 3 4 windowObj>
  25. |
  26.    replyIMsg
  27.       <primitive 239 3 5 intuiMsgObj>
  28. |
  29.    replyIMsg: thisIntuiMsg
  30.       <primitive 239 3 5 thisIntuiMsg>
  31. |
  32.    getMessageClass: intuiMsgObject
  33.       ^ <primitive 239 3 10 intuiMsgObject>
  34. |
  35.    getMessageCode: intuiMsgObject
  36.       ^ <primitive 239 3 11 intuiMsgObject>
  37. |
  38.    getMessageQualifier: intuiMsgObject
  39.       ^ <primitive 239 3 12 intuiMsgObject>
  40. |
  41.    getMessageIAddress: intuiMsgObject
  42.       ^ <primitive 239 3 13 intuiMsgObject>
  43. |
  44.    getMessageMouseX: intuiMsgObject
  45.       ^ <primitive 239 3 14 intuiMsgObject>
  46. |
  47.    getMessageMouseY: intuiMsgObject
  48.       ^ <primitive 239 3 15 intuiMsgObject>
  49. |
  50.    getMessageSeconds: intuiMsgObject
  51.       ^ <primitive 239 3 16 intuiMsgObject>
  52. |
  53.    getMessageMicros: intuiMsgObject
  54.       ^ <primitive 239 3 17 intuiMsgObject>
  55. |
  56.    getGadgetType: intuiMsgObject
  57.       ^ <primitive 239 3 18 intuiMsgObject>
  58. |
  59.    refreshWindow
  60.       <primitive 239 3 6 windowObj>
  61. |
  62.    postFilterIMsg
  63.       ^ intuiMsgObj <- <primitive 239 3 7 intuiMsgObj>
  64. |
  65.    filterIMsg
  66.       ^ intuiMsgObj <- <primitive 239 3 8 intuiMsgObj>
  67. |
  68.    windowIs
  69.       ^ windowObj " Tell subclasses what Window they are attached to "
  70. |
  71.    registerTo: aWindowObject
  72.       ^ windowObj <- aWindowObject
  73. |
  74.    visualInfoObject
  75.       ^ visualInfoObj
  76. |
  77.    freeVisualInfo
  78.       <primitive 239 3 0 visualInfoObj>. 
  79.  
  80.       " visualInfoObj cannot be used after this unless you perform
  81.       * getVisualInfo:tags: again
  82.       "
  83.  
  84.       ^ visualInfoObj <- nil
  85. |
  86.    getVisualInfo: screenObj tags: tagArray
  87.       visualInfoObj <- <primitive 239 3 1 screenObj tagArray>.
  88.  
  89.       (visualInfoObj isNil)
  90.          ifTrue: [ 'ERROR: could NOT obtain visualInfo from screen!' print.
  91.                    ^ nil
  92.                  ].
  93.                  
  94.       ^ visualInfoObj
  95. ]
  96.  
  97. " --------------------------------------------------------------------- " 
  98. " NewGadgets Class is the class that interfaces AmigaTalk to the        "
  99. " new gadgets portion of gadtools.library                               "
  100. " --------------------------------------------------------------------- " 
  101.  
  102. Class NewGadgets :GadTools ! private gadgetList aNewGadgetObj windowObj !
  103. [
  104.    dispose
  105.       ^ nil
  106. |
  107.    disposeGadgetList: gadgetListObj
  108.       " Equivalent to FreeGadgets() from gadtools.library: "
  109.       <primitive 239 0 0 gadgetListObj>
  110. |
  111.    allocateGadgetList
  112.       ^ gadgetList <- <primitive 239 0 1>.
  113. |
  114.    createGadgetList
  115.       " Equivalent to CreateContext() from gadtools.library: "
  116.       ^ private <- <primitive 239 0 2 gadgetList>.
  117. |
  118.    disposeNewGadget: unNeededNewGadgetObj
  119.       " You will have to keep track of every newGadgetObj returned
  120.       * from makeNewGadget: & use this method on ALL of them 
  121.       * (unless you have memory to burn).  Once you've called
  122.       * addGadgetToList:type:tags:, a newGadgetObj is no longer
  123.       * needed & perhaps you should use this method afterwards:
  124.       "
  125.       <primitive 239 0 7 unNeededNewGadgetObj>.
  126.  
  127.       ^ nil
  128. |
  129.    makeNewGadget: structureArray ! desiredSize !
  130.       desiredSize <- 12.
  131.       
  132.       " structureArray is an Array Object with the following
  133.       * elements in the given order:
  134.       *   ele[1]  <- ng_LeftEdge,   ele[2]  <- ng_TopEdge,
  135.       *   ele[3]  <- ng_Width,      ele[4]  <- ng_Height,
  136.       *   ele[5]  <- ng_GadgetText, ele[6]  <- ng_TextAttr,
  137.       *   ele[7]  <- ng_GadgetID,   ele[8]  <- ng_Flags,
  138.       *   ele[9]  <- ng_VisualInfo, ele[10] <- ng_UserData
  139.       *
  140.       *   ele[11] <- NewGadget Type Tag
  141.       *   ele[12] <- HotKey or nil.
  142.       *
  143.       *   ele[10] (UserData) can be any AmigaTalk object 
  144.       *   but I recommend that you use a #methodSymbol.
  145.       *
  146.       *   ele[7] (GadgetID) should be a 16-Bit Integer value.
  147.       "
  148.       ^ aNewGadgetObj <- <primitive 239 0 3 structureArray desiredSize>
  149. |
  150.    newStructArray: initArray ! newArray !
  151.       " Example usage:
  152.       * gType        <- intuition getGadgetType: #BUTTON_KIND
  153.       * newGadget    <- NewGadgets new
  154.       * vi           <- newGadget visualInfoObject
  155.       * hotKey       <- $K
  156.       * newStruct    <- newGadget newStructArray: #( 10 40 100 20 'My _Gadget'
  157.       *                                              textAttrObj gadgetID 
  158.       *                                              myFlags vi
  159.       *                                              userData gType hotKey)
  160.       * newGadgetObj <- newGadget makeNewGadget: newStruct
  161.       "
  162.       newArray <- Array new: 12.
  163.       
  164.       newArray at: 1  put: (initArray at: 1).
  165.       newArray at: 2  put: (initArray at: 2).
  166.       newArray at: 3  put: (initArray at: 3).
  167.       newArray at: 4  put: (initArray at: 4).
  168.       newArray at: 5  put: (initArray at: 5).
  169.       newArray at: 6  put: (initArray at: 6).
  170.       newArray at: 7  put: (initArray at: 7).
  171.       newArray at: 8  put: (initArray at: 8).
  172.       newArray at: 9  put: (initArray at: 9).
  173.       newArray at: 10 put: (initArray at: 10).
  174.       newArray at: 11 put: (initArray at: 11).
  175.       newArray at: 12 put: (initArray at: 12).
  176.  
  177.       ^ newArray
  178. |
  179.    addGadgetToList: newGadgetObj at: gadgetObj type: gType tags: tagArray
  180.       " Equivalent to CreateGadgetA() from gadtools.library: "
  181.       ^ <primitive 239 0 4 gadgetObj newGadgetObj gType tagArray>
  182. |
  183.    setGadgetAttrs: gadgetObj with: tagArray
  184.       " Equivalent to GT_SetGadgetAttrsA() from gadtools.library: "
  185.       <primitive 239 0 5 gadgetObj windowObj tagArray>
  186. |
  187.    getGadgetAttrs: gadgetObj with: tagArray
  188.       " Equivalent to GT_GetGadgetAttrsA() from gadtools.library: "
  189.       ^ <primitive 239 0 6 gadgetObj windowObj tagArray>
  190. |
  191.    registerTo: aWindowObject
  192.       (aWindowObject isNil)
  193.          ifTrue: [ 'NewGadgets Object given a nil Window object!' print.
  194.                    ^ nil
  195.                  ].
  196.                  
  197.       ^ windowObj <- aWindowObject
  198. |
  199.    waitForGadgetValue ! rval !
  200.       " Use the returned Object (or copy it) BEFORE using any method 
  201.       * that uses <primitive 239 3 9 windowObj> again!
  202.       "
  203.       rval <- <primitive 239 3 9 windowObj>.
  204.       
  205.       ^ (rval at: 1)
  206. |
  207.    waitForGadgetUserData ! rval !
  208.       " Smalltalk code has to call this inside a loop if there
  209.       * is more than one IDCMP event expected.  You do NOT
  210.       * need to use beginRefresh or endRefresh arround this
  211.       * method.  Any AmigaTalk Object is valid as the
  212.       * UserData stored in the NewGadget.
  213.       *
  214.       * Use the returned Object (or copy it) BEFORE using any method 
  215.       * that uses <primitive 239 3 9 windowObj> again!
  216.       "
  217.       rval <- <primitive 239 3 9 windowObj>.
  218.       
  219.       ^ (rval at: 2)
  220. |
  221.    checkForGadgetValue ! rval ! 
  222.  
  223.       " Use the returned Object (or copy it) BEFORE using any method 
  224.       * that uses <primitive 239 3 19 windowObj> again!
  225.       "
  226.       rval <- <primitive 239 3 19 windowObj>.
  227.       
  228.       (rval notNil)
  229.          ifTrue: [ ^ (rval at: 1)]
  230.       
  231.       ^ rval " Simply return the nil "
  232. |
  233.    checkForGadgetUserData ! rval !
  234.       " Smalltalk code has to call this inside a loop if there
  235.       * is more than one IDCMP event expected.  You do NOT
  236.       * need to use beginRefresh or endRefresh arround this
  237.       * method.  Any AmigaTalk Object is valid as the
  238.       * UserData stored in the NewGadget.
  239.       *
  240.       * Use the returned Object (or copy it) BEFORE using any method 
  241.       * that uses <primitive 239 3 19 windowObj> again!
  242.       "
  243.       rval <- <primitive 239 3 19 windowObj>.
  244.  
  245.       (rval notNil)      
  246.          ifTrue: [^ (rval at: 2)]
  247.  
  248.       ^ rval " Simply return the nil "
  249. |
  250.    getUserData: intuiMsgObj
  251.       " User pressed a gadget, so get the User Data associated with it: "
  252.       ^ <primitive 239 0 8 intuiMsgObj>
  253. |
  254.    getGadgetID: intuiMsgObj
  255.       " User pressed a gadget, so get the GadgetID associated with it: "
  256.       ^ <primitive 239 0 9 intuiMsgObj>
  257. ]
  258.  
  259. " --------------------------------------------------------------------- " 
  260. " NewMenus Class is the class that interfaces AmigaTalk to the          "
  261. " new Menus portion of gadtools.library                                 "
  262. ""
  263. "   Making a menu: "
  264.  
  265. ""
  266. "   menu <- NewMenus new "
  267. "   menu allocateNewMenu: 3 "
  268. "   menu1Array <- Array new: 6 "
  269. "   menu2Array <- Array new: 6 "
  270. "   intuition  <- Intuition new "
  271. ""
  272. "   menu1Array at: 1 put: (intuition getGadToolAttr: #NM_TITLE)"
  273. "   menu1Array at: 2 put: 'PROJECT' "
  274. "   menu1Array at: 3 put: 0  NO nm_CommKey for a Menu Title! "
  275. "   menu1Array at: 4 put: 0 "
  276. "   menu1Array at: 5 put: 0 "
  277. "   menu1Array at: 6 put: 0 "
  278. ""
  279. "   menu2Array at: 1 put: (intuition getGadToolAttr: #NM_ITEM)"
  280. "   menu2Array at: 2 put: 'Load a file..' "
  281. "   menu2Array at: 3 put: 'L' "
  282. "   menu2Array at: 4 put: 0 "
  283. "   menu2Array at: 5 put: 0 "
  284. "   menu2Array at: 6 put: 0 "
  285. ""
  286. "   menu fillNewMenuItem: 1 with: menu1Array "
  287. "   menu fillNewMenuItem: 2 with: menu2Array "
  288. ""
  289. "   You MUST have one of these for a valid menu strip: "
  290. "   menu fillNewMenuItem: 3 with: (menu endOfMenuArray: intuition) "
  291. ""
  292. "   chk1 <- menu createMenuStrip: tagArray1 -- CreateMenusA() tags apply here "
  293. "   chk2 <- initializeMenus: tagArray2      -- LayoutMenusA() tags apply here "
  294. " --------------------------------------------------------------------- " 
  295.  
  296. Class NewMenus :GadTools ! private newMenuArrayObj windowObj !
  297. [
  298.    disposeMenu
  299.       <primitive 239 1 0 private newMenuArrayObj>
  300. |
  301.    dispose               " Synonym for disposeMenu: "
  302.       self disposeMenu
  303. |
  304.    allocateNewMenu: numItems ! chk !
  305.       " newMenuArrayObj is an Array of NewMenu objects "
  306.  
  307.       chk <- <primitive 239 1 1 numItems>.
  308.  
  309.       (chk isNil)
  310.          ifTrue: [ 'Did NOT allocateNewMenu:' print].
  311.          
  312.       ^ newMenuArrayObj <- chk
  313. |
  314.    endOfMenuArray: intuitionObj ! endArray !
  315.       endArray  <- Array new: 6.
  316.  
  317.       endArray at: 1 put: (intuitionObj getGadToolAttr: #NM_END).
  318.       endArray at: 2 put: nil. " NO nm_Label        "
  319.       endArray at: 3 put: nil. " NO nm_CommKey      "
  320.       endArray at: 4 put: 0.   " NO nm_Flags        "
  321.       endArray at: 5 put: 0.   " NO nm_MutualExclude"
  322.       endArray at: 6 put: 0.   " NO nm_UserData     "
  323.  
  324.       ^ endArray
  325. |
  326.    xxxMakeArray: t k: k f: f x: ex data: data ! rval !
  327.       " See fileNewMenuItem comments: "
  328.  
  329.       rval <- Array new: 6.
  330.  
  331.       rval at: 2 put: t.
  332.       rval at: 3 put: k.
  333.       rval at: 4 put: f.
  334.       rval at: 5 put: ex.
  335.       rval at: 6 put: data.
  336.       
  337.       ^ rval
  338. |
  339.    initMenuArray: intObj title: title key: commKey flags: flags exclude: mx data: userData 
  340.       ! rval !
  341.       " Make a new Menu.  See fileNewMenuItem comments: "
  342.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData.
  343.  
  344.       rval at: 1 put: (intObj getGadToolAttr: #NM_TITLE).
  345.       
  346.       ^ rval
  347. |
  348.    initMenuItemArray: intObj title: title key: commKey flags: flags exclude: mx data: userData 
  349.       ! rval !
  350.       " Make a new MenuItem.  See fileNewMenuItem comments: "
  351.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData.
  352.  
  353.       rval at: 1 put: (intObj getGadToolAttr: #NM_ITEM).
  354.       
  355.       ^ rval
  356. |
  357.    initSubItemArray: intObj title: title key: commKey flags: flags exclude: mx data: userData 
  358.       ! rval !
  359.       " Make a new SubItem.  See fileNewMenuItem comments: "
  360.  
  361.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData.
  362.  
  363.       rval at: 1 put: (intObj getGadToolAttr: #NM_SUB).
  364.       
  365.       ^ rval
  366. |
  367.    initMenuImageArray: intObj title: title key: commKey flags: flags exclude: mx data: userData
  368.       ! rval !
  369.       " Make a new MenuItem.  See fileNewMenuItem comments: "
  370.  
  371.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData.
  372.  
  373.       rval at: 1 put: (intObj getGadToolAttr: #IM_ITEM).
  374.       
  375.       ^ rval
  376. |
  377.    initSubImageArray: intObj title: title key: commKey flags: flags exclude: mx data: userData
  378.       ! rval !
  379.       " Make a new SubItem.  See fileNewMenuItem comments: "
  380.  
  381.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData.
  382.  
  383.       rval at: 1 put: (intObj getGadToolAttr: #IM_SUB).
  384.       
  385.       ^ rval
  386. |
  387.    fillNewMenuItem: itemNumber with: structureArray
  388.       " structureArray is an Array Object with the following
  389.       * elements in the given order:
  390.       * ele[1] <- nm_Type,          ele[2] <- nm_Label,
  391.       * ele[3] <- nm_CommKey,       ele[4] <- nm_Flags,
  392.       * ele[5] <- nm_MutualExclude, ele[6] <- nm_UserData 
  393.       *
  394.       * ele[6] is an Array as follows:
  395.       *
  396.       *    udele[1] <- menu Type
  397.       *    udele[2] <- menu ID Integer or String,
  398.       *    udele[3] <- userData (Usually a #methodSymbol,
  399.       *    udele[4] <- equivalent to ele[2] (nm_CommKey)
  400.       "
  401.       (<primitive 239 1 2 itemNumber structureArray newMenuArrayObj> ~= true)
  402.          ifTrue: [ self disposeMenu.
  403.                    'ERROR:  Could NOT fill a NewMenu entry!' print.
  404.                    ^ nil
  405.                  ] 
  406. |
  407.    createMenuStrip: tagArray ! chk !
  408.       chk <- <primitive 239 1 3 newMenuArrayObj tagArray>.
  409.       
  410.       (chk isNil)
  411.          ifTrue: [ 'Did NOT createMenuStrip:' print.
  412.                    ^ nil
  413.                  ].
  414.          
  415.       ^ private <- chk
  416. |
  417.    visualInfo
  418.       ^ (super visualInfoObject)
  419. |
  420.    initializeMenus: tagArray ! chk viObj !
  421.       " This method returns true if successful, false if the menus
  422.       * could NOT be laid-out, nil if there is an error condition.
  423.       "
  424.       viObj <- self visualInfo.
  425.       chk   <- <primitive 239 1 4 private viObj tagArray>.
  426.  
  427.       (chk ~= true)
  428.          ifTrue: [ 'Did NOT initialize NewMenus object!' print.
  429.                    ^ false
  430.                  ].
  431.       ^ true
  432. |
  433.    initializeMenus: viObj tags: tagArray ! chk !
  434.       " This method returns true if successful, false if the menus
  435.       * could NOT be laid-out, nil if there is an error condition.
  436.       "
  437.       chk   <- <primitive 239 1 4 private viObj tagArray>.
  438.  
  439.       (chk ~= true)
  440.          ifTrue: [ 'Did NOT initialize NewMenus object!' print.
  441.                    ^ false
  442.                  ].
  443.       ^ true
  444. |
  445.    waitForMenuString ! rval !
  446.       " Smalltalk code has to call this inside a loop if there
  447.       * is more than one IDCMP event expected.  You do NOT
  448.       * need to use beginRefresh or endRefresh arround this
  449.       * method.
  450.       *
  451.       * Use the returned Object (or copy it) BEFORE using any method 
  452.       * that uses <primitive 239 3 9 windowObj> again!
  453.       "
  454.       rval <- <primitive 239 3 9 windowObj>.
  455.       
  456.       ^ (rval at: 2)
  457. |
  458.    waitForMenuUserData ! rval !
  459.       " Smalltalk code has to call this inside a loop if there
  460.       * is more than one IDCMP event expected.  You do NOT
  461.       * need to use beginRefresh or endRefresh arround this
  462.       * method.  Make sure that you use only AmigaTalk Objects
  463.       * as the UserData stored in the NewMenu.  This method will
  464.       * return nil if the Menu Item selected was NULL.
  465.       *
  466.       * Use the returned Object (or copy it) BEFORE using any method 
  467.       * that uses <primitive 239 3 9 windowObj> again!
  468.       "
  469.       rval <- <primitive 239 3 9 windowObj>.
  470.       
  471.       ^ (rval at: 1)
  472. |
  473.    getMenuUserData: intuiMsgCode
  474.       " User selected a menu item, so return the User Data associated with it: "
  475.       ^ <primitive 239 1 5 windowObj intuiMsgCode>
  476. |
  477.    getMenuItem: intuiMsgCode
  478.       " Returns the MenuItem selected as an Object: "
  479.       ^ <primitive 239 1 6 windowObj intuiMsgCode>
  480. |
  481.    isMenuNull: intuiMsgCode
  482.       " check to see if the intuiMsgCode is MENUNULL, return true or false: "
  483.       ^ <primitive 239 1 7 private intuiMsgCode>
  484. |
  485.    getMenuNumber: intuiMsgCode
  486.       ^ <primitive 239 1 8 intuiMsgCode>
  487. |
  488.    getMenuItemNumber: intuiMsgCode
  489.       ^ <primitive 239 1 9 intuiMsgCode>
  490. |
  491.    getSubNumber: intuiMsgCode
  492.       ^ <primitive 239 1 10 intuiMsgCode>
  493. |
  494.    getFullMenuNumber: intuiMsgCode
  495.       ^ <primitive 239 1 11 intuiMsgCode>
  496. |
  497.    registerTo: aWindowObject
  498.       (aWindowObject isNil)
  499.          ifTrue: [ 'NewMenus Object given a nil Window object!' print.
  500.                    ^ nil
  501.                  ].
  502.                  
  503.       ^ windowObj <- aWindowObject
  504. ]
  505.